home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / units / hercules.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-10-12  |  16.0 KB  |  386 lines
  1. UNIT Hercules;
  2. INTERFACE
  3.  
  4. {***************************************************************************}
  5. TYPE Bob=OBJECT                         { Bob object                        }
  6.        Xl,Yl,Bc:BYTE;                   { Length, Height , backgroundcolor  }
  7.        Fg,Bg:ARRAY[0..63,0..63] OF BYTE;{ Foreground and background array   }
  8.        PROCEDURE GetFg(X,Y:WORD);       { Get Fg array                      }
  9.        PROCEDURE SetFg(X,Y:WORD);       { Set Fg array                      }
  10.        PROCEDURE GetBg(X,Y:WORD);       { Get Bg array                      }
  11.        PROCEDURE SetBg(X,Y:WORD);       { Set Bg array                      }
  12.      END;                               {                                   }
  13. {***************************************************************************}
  14. CONST Text    =033; {00100001}          { Since both Text and Graphics uses }
  15.       Graphic =003; {00000011}          { the same memory area you have to  }
  16. {***************************************************************************}
  17. VAR   Page    ,                         { be careful when using routines    }
  18.       Mode    :BYTE;                    { that writes 'text' to the screen  }
  19.       MaxX    ,                         { then in graphics mode, one of     }
  20.       MaxY    :WORD;                    { these functions is READLN(); !!!  }
  21.       Fh      :BYTE;                    { Fontheight                        }
  22. {***************************************************************************}
  23. PROCEDURE SetMode(Md:BYTE);             { Set either text or graph. Page 0  }
  24. PROCEDURE SetPix(X,Y:WORD; P:BYTE);     { Sets pixel on Page, P=0,1,2       }
  25. FUNCTION  GetPix(X,Y:WORD):BYTE;        { Returns pixel color in Page (0/1) }
  26. PROCEDURE Clear(P:BYTE);                { Clears/Sets the whole Page        }
  27. PROCEDURE ChangePage;                   { Switches Page                     }
  28. {***************************************************************************}
  29. PROCEDURE ClearBoth(M:BYTE);            { Clears both pages                 }
  30. PROCEDURE Hline(Xa,Xb,Y:WORD; Color:BYTE); { Horizontal line                }
  31. PROCEDURE Vline(X,Ya,Yb:WORD; Color:BYTE); { Vertical line                  }
  32. PROCEDURE Box(Xa,Ya,Xb,Yb:WORD; Color:BYTE); { Draws a rectangle            }
  33. PROCEDURE Fbox(Xa,Ya,Xb,Yb:WORD; Color:BYTE); { Draws a filled rectangle    }
  34. PROCEDURE Line(X1,Y1,X2,Y2:INTEGER; Col:BYTE); { Draws any line             }
  35. {***************************************************************************}
  36. FUNCTION  UseFont(Ptr:POINTER):POINTER; { UseFont(@Proc/Pointer)            }
  37. PROCEDURE PlotChar(X,Y:INTEGER; Ch:BYTE; Color,Bg:BYTE); { Plots CHAR expl. }
  38. PROCEDURE DrawChar(X,Y:INTEGER; Ch:BYTE; Color:BYTE); { Plots CHAR only     }
  39. PROCEDURE WriteLine(X,Y:INTEGER; S:STRING; C,B:BYTE); { C=B->Draw / Plot    }
  40. {***************************************************************************}
  41.  
  42. IMPLEMENTATION
  43.  
  44. VAR   A,B:BYTE;
  45. CONST CrtReg=$03B4;
  46.       CrtCnt=$03B8;
  47.       CrtCnf=$03BF;
  48.       VideoS=$B000;
  49.  
  50. PROCEDURE SetMode(Md:BYTE); ASSEMBLER;
  51.  ASM
  52.         MOV     DX,CrtCnt               { Enable the Mode, but turn off the }
  53.         MOV     AL,Md                   { screen, for modechange.           }
  54.         OUT     DX,AX
  55.         MOV     DX,CrtReg
  56.         CMP     AL,Text                 { Is it text or graphics mode?      }
  57.         JE      @Text
  58.         MOV     AX,$3500; OUT DX,AX     { Enable Special CRT graphics mode. }
  59.         MOV     AX,$2D01; OUT DX,AX
  60.         MOV     AX,$2E02; OUT DX,AX
  61.         MOV     AX,$0703; OUT DX,AX
  62.         MOV     AX,$5B04; OUT DX,AX
  63.         MOV     AX,$0205; OUT DX,AX
  64.         MOV     AX,$5706; OUT DX,AX
  65.         MOV     AX,$5707; OUT DX,AX
  66.         MOV     AX,$0208; OUT DX,AX
  67.         MOV     AX,$0309; OUT DX,AX
  68.         MOV     AX,$000A; OUT DX,AX
  69.         MOV     AX,$000B; OUT DX,AX
  70.         MOV     MaxX,719                { Report Max resolution.            }
  71.         MOV     MaxY,347
  72.         JMP     @Next
  73. @Text:  MOV     AX,$6100; OUT DX,AX     { Enable special CRT text mode.     }
  74.         MOV     AX,$5001; OUT DX,AX
  75.         MOV     AX,$5202; OUT DX,AX
  76.         MOV     AX,$0F03; OUT DX,AX
  77.         MOV     AX,$1904; OUT DX,AX
  78.         MOV     AX,$0605; OUT DX,AX
  79.         MOV     AX,$1906; OUT DX,AX
  80.         MOV     AX,$1907; OUT DX,AX
  81.         MOV     AX,$0208; OUT DX,AX
  82.         MOV     AX,$0D09; OUT DX,AX
  83.         MOV     AX,$0B0A; OUT DX,AX
  84.         MOV     AX,$0C0B; OUT DX,AX
  85.         MOV     MaxX,79                 { Report max resolution.            }
  86.         MOV     MaxY,24
  87. @Next:  MOV     DX,CrtCnt               { Now enable this mode and turn the }
  88.         MOV     AL,Md                   { screen back on.                   }
  89.         OR      AL,00001000b
  90.         OUT     DX,AL
  91.         MOV     Page,0                  { Save both mode and page number.   }
  92.         MOV     Mode,AL
  93.  END;
  94.  
  95. PROCEDURE SetPix(X,Y:WORD; P:BYTE); ASSEMBLER;
  96.  ASM
  97.         MOV     BX,X                    { Save X in BX                      }
  98.         MOV     DX,Y                    { Save Y in DX                      }
  99.         CMP     BX,MaxX                 { Is X>MaxX ?                       }
  100.         JG      @Ende                   { Yes, end this procedure           }
  101.         CMP     DX,MaxY                 { No , Is Y>MaxY ?                  }
  102.         JG      @Ende                   { Yes, end this procedure           }
  103.         XOR     DI,DI                   { No ,Clear DI                      }
  104.         MOV     CX,VideoS               { CX=Basic Video Segment address    }
  105.         CMP     Page,0                  { Is current page Page 0 ?          }
  106.         JE      @Next                   { Yes, Do not add anything to Seg.  }
  107.         ADD     CX,$0800                { No , Add $800 to get Page 1       }
  108. @Next:  MOV     ES,CX                   { Save This segment in ExtraSement  }
  109.         MOV     AX,DX                   { AX=Y                              }
  110.         SHR     AX,2                    { Divide AX by four                 }
  111.         MOV     CL,90                   { Prepare multiplication            }
  112.         MUL     CL                      { Multiply line by 90               }
  113.         AND     DX,00000011b            { remove anything but b0,1 in DX (Y)}
  114.         ROR     DX,3                    { Shift DX by 3                     }
  115.         MOV     DI,BX                   { DI = X value                      }
  116.         SHR     DI,3                    { Divide DI by 8                    }
  117.         ADD     DI,AX                   { + 90 * INT( Line DIV 4 )          }
  118.         ADD     DI,DX                   { + $2000 * ( Line MOD 4 )          }
  119.         MOV     CL,7                    { Maximum of 7 moves                }
  120.         AND     BX,7                    { Column MOD 8                      }
  121.         SUB     CL,BL                   { 7 - Column MOD 8                  }
  122.         MOV     AH,1                    { Prepare to determine bit position }
  123.         SHL     AH,CL                   { Determine bit position            }
  124.         MOV     AL,ES:[DI]              { Get byte value of bitposition     }
  125.         CMP     P,1
  126.         JNE     @Nxt1
  127.         OR      AL,AH
  128.         JMP     @End1
  129. @Nxt1:  CMP     P,0
  130.         JNE     @Nxt2
  131.         NOT     AH
  132.         AND     AL,AH
  133.         JMP     @End1
  134. @Nxt2:  XOR     AL,AH
  135. @End1:  MOV     ES:[DI],AL
  136. @Ende:
  137.  END;
  138.  
  139. FUNCTION  GetPix(X,Y:WORD):BYTE; ASSEMBLER;
  140.  ASM
  141.         MOV     BX,X                    { Save X in BX                      }
  142.         MOV     DX,Y                    { Save Y in DX                      }
  143.         CMP     BX,MaxX                 { Is X>MaxX ?                       }
  144.         JG      @Ende                   { Yes, end this procedure           }
  145.         CMP     DX,MaxY                 { No , Is Y>MaxY ?                  }
  146.         JG      @Ende                   { Yes, end this procedure           }
  147.         XOR     DI,DI                   { No ,Clear DI                      }
  148.         MOV     CX,VideoS               { CX=Basic Video Segment address    }
  149.         CMP     Page,0                  { Is current page Page 0 ?          }
  150.         JE      @Next                   { Yes, Do not add anything to Seg.  }
  151.         ADD     CX,$0800                { No , Add $800 to get Page 1       }
  152. @Next:  MOV     ES,CX                   { Save This segment in ExtraSement  }
  153.         MOV     AX,DX                   { AX=Y                              }
  154.         SHR     AX,2                    { Divide AX by four                 }
  155.         MOV     CL,90                   { Prepare multiplication            }
  156.         MUL     CL                      { Multiply line by 90               }
  157.         AND     DX,11                   { remove anything but b0,1 in DX (Y)}
  158.         ROR     DX,3                    { Shift DX by 3                     }
  159.         MOV     DI,BX                   { DI = X value                      }
  160.         SHR     DI,3                    { Divide DI by 8                    }
  161.         ADD     DI,AX                   { + 90 * INT( Line DIV 4 )          }
  162.         ADD     DI,DX                   { + $2000 * ( Line MOD 4 )          }
  163.         MOV     CL,7                    { Maximum of 7 moves                }
  164.         AND     BX,7                    { Column MOD 8                      }
  165.         SUB     CL,BL                   { 7 - Column MOD 8                  }
  166.         MOV     AH,1                    { Prepare to determine bit position }
  167.         SHL     AH,CL                   { Determine bit position            }
  168.         MOV     AL,ES:[DI]              { Get byte value of bitposition     }
  169.         NOT     AH                      { Make bitmask                      }
  170.         AND     AL,AH                   { Use mask on bytevalue             }
  171.         CMP     AL,0                    { Is AL = 0 (bit is blank)          }
  172.         JE      @Ende                   { Yes, Return 0                     }
  173.         MOV     AL,1                    { No , Return 1                     }
  174. @Ende:
  175.  END;
  176.  
  177. PROCEDURE Clear(P:BYTE); ASSEMBLER;
  178.  ASM
  179.         MOV     AX,$0700
  180.         MOV     CX,$2000
  181.         MOV     BL,Mode
  182.         AND     BL,00100011b
  183.         CMP     BL,Text
  184.         JE      @Next
  185.         MOV     CX,$4000                { CX = $4000 one whole graphic page }
  186.         MOV     AX,0                    { Prepare to clear graphics         }
  187.         CMP     P,0                     { Is P=0 ?                          }
  188.         JE      @Next                   { Yes, keep current AX              }
  189.         MOV     AX,$FFFF                { No , Prepare to set whole screen  }
  190. @Next:  XOR     DI,DI                   { DI = 0                            }
  191.         MOV     CX,$4000                { CX = $4000 one whole graphic page }
  192.         MOV     BX,VideoS               { BX = Basic Video segment address  }
  193.         CMP     Page,0                  { Is this page 0 ?                  }
  194.         JE      @Nxt2                   { Yes, prepare to execute           }
  195.         ADD     BX,$0800                { No , prepare page 1               }
  196. @Nxt2:  MOV     ES,BX                   { ES = This video segment           }
  197.         REP     STOSW                   { REPEAT clear/set op. until CX=0   }
  198.  END;
  199.  
  200. PROCEDURE ChangePage; ASSEMBLER;
  201.  ASM
  202.         MOV     AL,Mode
  203.         MOV     DX,CrtCnt
  204.         XOR     AL,10000000b; OUT DX,AL
  205.         MOV     Mode,AL
  206.         INC     Page
  207.         CMP     Page,1
  208.         JE      @Ende
  209.         MOV     Page,0
  210. @Ende:  
  211.  END;
  212.  
  213. {***************************************************************************}
  214.  
  215. PROCEDURE ClearBoth(M:BYTE);
  216.  BEGIN
  217.    ChangePage; Clear(0);
  218.    ChangePage; Clear(0);
  219.  END;
  220.  
  221. PROCEDURE Hline(Xa,Xb,Y:WORD; Color:BYTE);
  222.  BEGIN
  223.    FOR Xa:=Xa TO Xb DO SetPix(Xa,Y,Color);
  224.  END;
  225.  
  226. PROCEDURE Vline(X,Ya,Yb:WORD; Color:BYTE);
  227.  BEGIN
  228.    FOR Ya:=Ya TO Yb DO SetPix(X,Ya,Color);
  229.  END;
  230.  
  231. PROCEDURE Box(Xa,Ya,Xb,Yb:WORD; Color:BYTE);
  232.  BEGIN
  233.    Hline(Xa,Xb,Ya,Color); Hline(Xa,Xb,Yb,Color);
  234.    Vline(Xa,Ya,Yb,Color); Vline(Xb,Ya,Yb,Color);
  235.  END;
  236.  
  237. PROCEDURE Fbox(Xa,Ya,Xb,Yb:WORD; Color:BYTE);
  238.  BEGIN
  239.    IF ABS(Xb-Xa)<ABS(Yb-Ya) THEN FOR Xa:=Xa TO Xb DO Vline(Xa,Ya,Yb,Color)
  240.                             ELSE FOR Ya:=Ya TO Yb DO Hline(Xa,Xb,Ya,Color);
  241.  END;
  242.  
  243. PROCEDURE Line(X1,Y1,X2,Y2:INTEGER; Col:BYTE);
  244.  VAR D,Dx,Dy,Ai,Bi,Xi,Yi,X,Y:INTEGER;
  245.  BEGIN                          
  246.    IF (ABS(X2-X1)<ABS(Y2-Y1)) THEN
  247.     BEGIN
  248.      IF Y1>Y2 THEN
  249.       ASM
  250.           MOV     AX,Y1
  251.           MOV     BX,Y2
  252.           MOV     Y1,BX
  253.           MOV     Y2,AX
  254.           MOV     AX,X1
  255.           MOV     BX,X2
  256.           MOV     X1,BX
  257.           MOV     X2,AX
  258.       END;
  259.       IF (X2>X1) THEN Xi:=1 ELSE Xi:=-1;
  260.       Dy:=Y2-Y1; Dx:=ABS(X2-X1); D:=Dx*2-Dy; Ai:=2*(Dx-Dy);
  261.       Bi:=Dx*2; X:=X1; Y:=Y1;
  262.       IF (X>=0) AND (Y>=0) AND (X<=MaxX) AND (Y<=MaxY)
  263.          THEN SetPix(X,Y,Col);
  264.       FOR Y:=Y1+1 TO Y2 DO
  265.        BEGIN
  266.          IF (D>=0) THEN
  267.           ASM
  268.             MOV AX,X
  269.             ADD AX,Xi
  270.             MOV X,AX
  271.             MOV AX,D
  272.             ADD AX,Ai
  273.             MOV D,AX
  274.           END ELSE ASM
  275.             MOV AX,D
  276.             ADD AX,Bi
  277.             MOV D,AX
  278.           END;
  279.          IF (X>=0) AND (Y>=0) AND (X<=MaxX) AND (Y<=MaxY)
  280.             THEN SetPix(X,Y,Col);
  281.        END;
  282.     END ELSE BEGIN             
  283.       IF (X1>X2) THEN
  284.        ASM
  285.          MOV AX,X1
  286.          MOV BX,X2
  287.          MOV X1,BX
  288.          MOV X2,AX
  289.          MOV AX,Y1
  290.          MOV BX,Y2
  291.          MOV Y1,BX
  292.          MOV Y2,AX
  293.        END;
  294.       IF (Y2>Y1) THEN Yi:=1 ELSE Yi:=-1;
  295.       Dx:=X2-X1; Dy:=ABS(Y2-Y1); D:=Dy*2-Dx; Ai:=2*(Dy-Dx);
  296.       Bi:=Dy*2; X:=X1; Y:=Y1;
  297.       IF (X>=0) AND (Y>=0) AND (X<=MaxX) AND (Y<=MaxY)
  298.          THEN SetPix(X,Y,Col);
  299.       FOR X:=X1+1 TO X2 DO
  300.        BEGIN
  301.          IF (D>=0) THEN
  302.           ASM
  303.             MOV AX,Y
  304.             ADD AX,Yi
  305.             MOV Y,AX
  306.             MOV AX,D
  307.             ADD AX,Ai
  308.             MOV D,AX
  309.           END ELSE ASM
  310.             MOV AX,D
  311.             ADD AX,Bi
  312.             MOV D,AX
  313.           END;
  314.          IF (X>=0) AND (Y>=0) AND (X<=MaxX) AND (Y<=MaxY)
  315.             THEN SetPix(X,Y,Col);
  316.        END;                     
  317.     END;                        
  318.  END;                           
  319.  
  320. {***************************************************************************}
  321.  
  322. {$L Romans.Obj} PROCEDURE RomansFont; EXTERNAL;
  323.  
  324. VAR Fs,Fo:WORD; 
  325.  
  326. FUNCTION  UseFont(Ptr:POINTER):POINTER;
  327.  BEGIN
  328.    Fs:=SEG(Ptr^); Fo:=OFS(Ptr^)+1; Fh:=MEM[Fs:Fo-1];
  329.    UseFont:=System.Ptr(Fs,Fo);
  330.  END;
  331.  
  332. PROCEDURE PlotChar(X,Y:INTEGER; Ch:BYTE; Color,Bg:BYTE);
  333.  VAR T,U:BYTE;
  334.  BEGIN
  335.    IF (X<0) OR (Y<0) OR (X>MaxX-8) OR (Y>MaxY-Fh) THEN Exit;
  336.    FOR T:=0 TO 7 DO FOR U:=0 TO Fh-1 DO
  337.    IF MEM[Fs:Fo+Ch*Fh+U] AND  (128 SHR (T AND 7))=(128 SHR (T AND 7))
  338.       THEN SetPix(X+T,Y+U,Color) ELSE SetPix(X+T,Y+U,Bg);
  339.  END;
  340.  
  341. PROCEDURE DrawChar(X,Y:INTEGER; Ch:BYTE; Color:BYTE);
  342.  VAR T,U:BYTE;
  343.  BEGIN
  344.    IF (X<0) OR (Y<0) OR (X>MaxX-8) OR (Y>MaxY-Fh) THEN Exit;
  345.    FOR T:=0 TO 7 DO FOR U:=0 TO Fh-1 DO
  346.    IF MEM[Fs:Fo+Ch*Fh+U] AND  (128 SHR (T AND 7))=(128 SHR (T AND 7))
  347.       THEN SetPix(X+T,Y+U,Color);
  348.  END;
  349.  
  350. PROCEDURE WriteLine(X,Y:INTEGER; S:STRING; C,B:BYTE);
  351.  VAR T:BYTE;
  352.  BEGIN                                          
  353.    FOR T:=1 TO LENGTH(S) DO
  354.     IF C=B THEN DrawChar(X+(T-1)*8,Y,ORD(S[T]),C  )
  355.            ELSE PlotChar(X+(T-1)*8,Y,ORD(S[T]),C,B);
  356.  END;
  357. {***************************************************************************}
  358. PROCEDURE Bob.GetFg(X,Y:WORD);
  359.  BEGIN
  360.    FOR A:=0 TO Xl DO FOR B:=0 TO Yl DO Fg[A,B]:=GetPix(X+A,Y+B);
  361.  END;
  362.  
  363. PROCEDURE Bob.SetFg(X,Y:WORD);
  364.  BEGIN
  365.    FOR A:=0 TO Xl DO FOR B:=0 TO Yl DO IF Fg[A,B]<>Bc THEN SetPix(X+A,Y+B,Fg[A,B]);
  366.  END;
  367.  
  368. PROCEDURE Bob.GetBg(X,Y:WORD);
  369.  BEGIN
  370.    FOR A:=0 TO Xl DO FOR B:=0 TO Yl DO Bg[A,B]:=GetPix(X+A,Y+B);
  371.  END;
  372.  
  373. PROCEDURE Bob.SetBg(X,Y:WORD);
  374.  BEGIN
  375.    FOR A:=0 TO Xl DO FOR B:=0 TO Yl DO SetPix(X+A,Y+B,Bg[A,B]);
  376.  END;
  377.  
  378.  
  379. BEGIN
  380.    ASM
  381.         MOV     DX,CrtCnf               { Enable 2 pages and Graphics       }
  382.         MOV     AL,00000011b
  383.         OUT     DX,AX
  384.    END;
  385.    UseFont(@RomansFont);
  386. END.